perm filename MAKNUM.F4[P11,LCS]1 blob
sn#570607 filedate 1981-03-09 generic text, type T, neo UTF8
SUBROUTINE MAKNUM(RNUM)
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
1 /STF/RSTFAC(8),RSTJ2
CC 1 /NFONT/NFONT
C*** PUT THIS IN AFTER ALPHA IS TRANSLATED
EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
DATA RS/10.0/,RBX/1.0/
RB8=R8
J3X=J3
C P7=0=BDR40; =1=BDI40; =2=PRIM.
IF(R6.GE.100.)R6=R6-100.
IF(R6.EQ.0)R6=1.
R5=R6
C IF R6 > 100 IT'S FOR THE PAGE PROG. SUBTRACT 100 TO GET TRUE SIZE
C IF IT'S 0 MAKE INTO 1.0 UPPER CASE - BDR40
IF(R7.GT.2.)R7=0
R6=48000000.0+(R7+50.)*10000.
R7=99999999.0
C BLANKS
ONE=0
IF(RNUM.NE.9999.)GO TO 2
C NEXT FOR 'C'OMMON TIME
RNUM=12.
C MAKES A 'C'
R4=R4-2.2
C .2 FOR BAD POS. OF LETTERS
GO TO 4
2 RNUM=IFIX(RNUM)
C SO MISTAKES (I.E. 2.2) WON'T BREAK THE PROG.
IF(RNUM.EQ.1.)ONE=3.
IF(RNUM.GT.9.)GO TO 3
C JUMP FOR 2 OR 3 DIGIT NUMBER
4 R6=R6+RNUM*100.+47.
C PUTS BLANK ON END (.47)
GO TO 1
3 RJY=10.
IF(RNUM.GE.100.)RJY=100.
B=IFIX(RNUM/RJY)
C=AMOD(RNUM,RJY)
IF(RNUM.LT.100)GO TO 7
D=IFIX(C/10.)
C=AMOD(C,10.)
IF(C.EQ.1.)ONE=ONE+3.
R7=C*1000000.+999999.0
C=D
7 R6=R6+B*100.+C
IF(B.EQ.1.)ONE=ONE+3.
IF(C.EQ.1.)ONE=ONE+3.
B=R5
IF(RNUM.GE.100.)B=B*2
J3=J3-RS*RSTJ2*B
C FOR 2 DIGIT NUMBER ADJUSTS FOR 11, ETC.
1 J3=J3+ONE*R5*RSTJ2
C CENTERS THE NUMBER '1'
MFONT=NFONT
CALL ALPHA
NFONT=MFONT
C RESTORE FONT TO WHATEVER IT WAS BEFORE
J3=J3X
IF(RB8.EQ.0)RETURN
C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
R3=J3-R5
IF(J10.EQ.0)J10=1
C USE J10 FOR EVEN THICKER BOX AND CIRC.
IF(RNUM.GT.9)R3=R3+R5*RBX
C TO SET CENTER
IF(RB8.EQ.2.)GO TO 5
R4=R4+R5+.1+.05/R5
C END OF ABOVE IS FOR SMALL CIRCLES.
B=4.5
IF(RNUM.GE.100.)B=5.5
R5=R5*B
J6=0
J7=0
J8=J10
CALL CENTX
CALL CIRCLE
RETURN
5 B=6.
R9=0
IF(RNUM.LT.100.)GO TO 8
B=9.
R9=R5*6.
C MAKES RECTANGLE IF >=100
8 R4=R4+R5*.7+.1
R8=R5*B
J5=50
R3=R3+1.0
C SHIFT BOX SLIGHTLY TO RIGHT
CALL ITMSUB
END